home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Precision Software Appli…tions Silver Collection 1
/
Precision Software Applications Silver Collection Volume One (PSM) (1993).iso
/
tutor
/
ada1tutr.arj
/
ADA_TUTR.ADA
next >
Wrap
Text File
|
1992-09-04
|
26KB
|
519 lines
-- ADA_TUTR.ADA Ver. 2.02 4-SEP-1992 Copyright 1988-1992 John J. Herro
-- Software Innovations Technology
-- 1083 Mandarin Drive NE, Palm Bay, FL 32905-4706 (407)951-0233
--
-- Before compiling this file, you must compile ONE of the following:
--
-- JANUS.ADA Recommended when using a PC with Janus/Ada.
-- MERIDIAN.ADA Recommended when using a PC with a Meridian Ada compiler
-- and the Meridian DOS Environment Library.
-- UNIX.ADA Recommended for UNIX based systems, if you can also
-- compile ONECHAR.C or ALTCHAR.C with a C compiler and
-- link with Ada.
-- VAX.ADA Recommended when using VAX Ada.
-- VANILLA.ADA "Plain vanilla" version for all other systems. Should work
-- with ANY standard Ada compiler. On some systems,
-- VANILLA.ADA may require you to strike ENTER after each
-- response. However, you don't have to strike ENTER with
-- recent versions of TeleGen Ada by Telesoft.
--
-- See the PRINT.ME file for more information on installing ADA-TUTR on other
-- computers.
--
--
-- Before Running ADA-TUTR on a PC:
--
-- ADA-TUTR uses ANSI escape sequences for highlighting, cursor positioning,
-- reverse video, etc. Before ADA-TUTR will work correctly on a PC, you must
-- install the device driver ANSI.SYS, which came with your copy of DOS. To
-- install ANSI.SYS, do the following:
--
-- 1. If there's a file CONFIG.SYS in the root directory of the disk from
-- which you boot, type it and look for a line saying "DEVICE=ANSI.SYS"
-- (without the quotes), in either upper or lower case. If that line isn't
-- present, add it to CONFIG.SYS anywhere in the file, using an ordinary
-- text editor or word processor in the non-document mode. If there's no
-- CONFIG.SYS file, create one containing the single line "DEVICE=ANSI.SYS"
-- (without the quotes).
--
-- 2. If there's no file ANSI.SYS in your root directory, copy ANSI.SYS from
-- your DOS distribution diskette to the root directory of the disk from
-- which you boot.
--
-- 3. Reboot the computer. ADA-TUTR should then work correctly.
--
-- Introduction:
--
-- ADA-TUTR provides interactive instruction in the Ada programming language,
-- allowing you to learn at your own pace. On a PC, access to an Ada compiler
-- is helpful, but not required. You can exit this program at any time by
-- striking X, and later resume the session exactly where you left off. If you
-- have a color monitor, you can set the foreground, background, and border
-- colors at any time by typing S.
--
-- ADA-TUTR presents a screenful of information at a time. Screens are read
-- in 64-byte blocks from the random access file ADA_TUTR.DAT, using DIRECT_IO.
-- For most screens, ADA-TUTR waits for you to strike one character to
-- determine which screen to show next. Screens are numbered starting with
-- 101; each screen has a three-digit number. Screens 101 through 108 have
-- special uses, as follows:
--
-- 101 - This screen is presented when you complete the Ada course. It
-- contains a congratulatory message. After this screen is shown,
-- control returns directly to the operating system; the program doesn't
-- wait for you to strike a character.
-- 102 - This screen is presented when you exit ADA-TUTR before completing the
-- course. After this screen is shown, control returns directly to the
-- operating system; the program doesn't wait for you to strike a
-- character.
-- 103 - This screen is shown whenever you strike X. It displays the number of
-- the last screen shown and the approximate percentage through the
-- course. It then asks if you want to exit the program. If you strike
-- Y, screen 102 is shown and control returns to the operating system.
-- If you type N, screen 108 is shown to provide a menu of further
-- choices. From screen 103, you can also strike M to see the main menu
-- (screen 106).
-- 104 - This is the opening screen. It asks if you've used ADA-TUTR before.
-- If you strike N, a welcome screen is presented and the course begins.
-- If you strike Y, screen 107 is shown.
-- 105 - This screen allows you to type the number of the next screen you want
-- to see. For this screen, instead of striking one character, you type
-- a three-digit number and presses ENTER. Any number from 104 through
-- the largest screen number is accepted.
-- 106 - This screen contains the main menu of topics covered in ADA-TUTR.
-- When you select a main topic, an appropriate sub-menu is shown.
-- 107 - This screen is shown when you say that you've used ADA-TUTR before.
-- It says "Welcome back!" and provides a menu that lets you resume where
-- you left off, go back to the last question or Outside Assignment, go
-- to the main menu (screen 106), or go to any specified screen number
-- (via screen 105).
-- 108 - This screen is shown when you answer N to screen 103. It provides a
-- menu similar to screen 107, except that the first choice takes you
-- back to the screen shown before you saw 103. For example, if you
-- strike X while viewing screen 300, you'll see screen 103. If you then
-- answer N, you'll see screen 108. From 108 the first menu selection
-- takes you back to 300.
--
-- Format of the Data File:
--
-- ADA-TUTR.DAT is a random access file of 64-byte blocks. The format of this
-- file changed considerably with version 2.00 of ADA-TUTR. It's now much more
-- compact, and, although it's still a data file, it now contains only the 95
-- printable ASCII characters.
--
-- The first block of ADA_TUTR.DAT is referred to as block 1, and the first 31
-- blocks together are called the index. Bytes 2 through 4 of block 1 contain,
-- in ASCII, the number of the welcome screen that's shown when you say that
-- you haven't used ADA-TUTR before. Bytes 6 through 8 of block 1 contain the
-- number of the highest screen in the course. (Bytes 1 and 5 of block 1
-- contain spaces.)
--
-- Bytes 9 of block 1 through the end of block 31 contain four bytes of
-- information for each of the possible screens 101 through 594. For example,
-- information for screen 101 is stored in bytes 9 through 12 of block 1, the
-- next four bytes are for screen 102, etc. For screens that don't exist, all
-- four bytes contain spaces.
--
-- The first of the four bytes is A if the corresponding screen introduces an
-- Outside Assignment, Q if the screen asks a question, or a space otherwise.
-- The next two bytes give the number of the block where data for the screen
-- begins, in base 95! A space represents 0, ! represents 1, " represents 2,
-- # represents 3, $ represents 4, etc., through all the printable characters
-- of the ASCII set. A tilde (~) represents 94.
--
-- The last of the four bytes gives the position, 1 through 64, within the
-- block where the data for this screen starts. Again, ! represents 1,
-- " represents 2, # represents 3, etc.
--
-- Data for the screens are stored starting in position 1 of block 32. In the
-- screen data, the following characters have special meaning:
--
-- % turns on high intensity.
-- @ displays the number of spaces indicated by the next
-- character (# represents 3, $ represents 4, etc.)
-- \ turns on reverse video and leaves one space.
-- ^ turns on high intensity and leaves one space.
-- ` restores normal video.
-- { causes CR-LF.
-- } moves cursor to row 24, column 1, for a prompt.
-- ~ restores normal video and leaves one space.
--
-- These characters have special meaning in screen 103 only:
--
-- # shows approximate percentage through the course.
-- $ shows the number of the screen seen before 103.
--
-- Immediately after }, b represents "Please type a space to go on, or B to go
-- back." and q represents "Please type a space to go on, or B or Q to go back
-- to the question."
--
--
-- The data for each screen is followed by the "control information" for that
-- screen, in square brackets. The control information is a list of characters
-- that you might strike after seeing this screen. Each character is followed
-- by the three-digit number of the next screen to be shown when that character
-- is struck. For example, Y107N120 is the control information for screen 104.
-- This means that if you strike Y, screen 107 will be shown next, and if you
-- strikes N, screen 120 will be shown. Striking any other character will
-- simply cause a beep (except that X can always be typed to exit the program,
-- S can always be typed to set colors, and CR will be ignored). If the
-- control information is simply #, you are prompted to type the next screen
-- number. This feature is used in screen 105.
--
-- A "screen number" of 098 following a character means "go back to the last
-- Outside Assignment," and 099 means "go back to the last question." These
-- special numbers are used in screens 107 and 108. Number 100 means "go back
-- to the previous screen seen."
--
-- ADA-TUTR opens the Data File in IN_FILE mode for read-only access.
--
--
--
-- Format of the User File:
--
-- The User File ADA_TUTR.USR initially doesn't exist. It's created the first
-- time ADA-TUTR is run.
--
-- ADA_TUTR.USR is a random access file containing one 64-byte block. Bytes 2
-- through 4 contain, in ASCII, the number of the last screen read the last
-- time you ran ADA-TUTR. Byte 6 contains a digit for the foreground color you
-- select, byte 8 contains a digit for the background color, and byte 10
-- contains a digit for the border color. All other bytes contain spaces. The
-- ASCII characters '0' through '7' represent black, red, green, yellow, blue,
-- magenta, cyan, and white, in that order. Note that not all color PCs have a
-- separate border color. ADA_TUTR.USR is a random access file so that it can
-- be easily updated by Ada. It contains 64 bytes so that it can be accessed
-- with the same package, namely RANDOM_IO, that accesses the Data File.
--
-- If the User File exists, ADA-TUTR opens it in INOUT_FILE mode for read/write
-- access. If it doesn't exist, ADA-TUTR creates it.
--
with CUSTOM_IO, DIRECT_IO; use CUSTOM_IO;
procedure ADA_TUTR is
subtype BLOCK_SUBTYPE is STRING(1 .. 64);
package RANDOM_IO is new DIRECT_IO(BLOCK_SUBTYPE); use RANDOM_IO;
DATA_FILE : FILE_TYPE; -- The file from which screens are read.
USER_FILE : FILE_TYPE; -- Remembers last screen seen, and colors.
BLOCK : BLOCK_SUBTYPE; -- Buffer for random-access I/O.
VPOS : INTEGER; -- Number of the current block.
HPOS : INTEGER; -- Current position within current block.
SN, OLD_SN : INTEGER := 104; -- Screen num. and previous screen num.
QUITTING_SN : INTEGER := 104; -- Screen number where you left off.
HIGHEST_SN : INTEGER; -- Highest screen number in the course.
WELCOME_SN : INTEGER; -- Number of the screen shown to new users.
INDX : STRING(1 .. 1984); -- Index from the Data File.
FILES_OK : BOOLEAN := FALSE; -- True when files open successfully.
LEGAL_NOTE : constant STRING := " Copyright 1988-92 John J. Herro ";
-- LEGAL_NOTE isn't used by the program, but it causes
-- most compilers to place this string in the .EXE file.
procedure OPEN_DATA_FILE is separate;
procedure OPEN_USER_FILE is separate;
procedure SHOW_CURRENT_SCREEN is separate;
procedure GET_NEXT_SCREEN_NUMBER is separate;
begin
OPEN_DATA_FILE;
OPEN_USER_FILE;
if FILES_OK then
SET_BORDER_COLOR(TO => BORDER_COLOR); -- Set default colors.
PUT(NORMAL_COLORS);
while SN > 0 loop -- "Screen number" of 0 means end the program.
PUT(CLEAR_SCRN); -- Clear the screen.
SHOW_CURRENT_SCREEN;
GET_NEXT_SCREEN_NUMBER;
end loop;
BLOCK := (others => ' '); -- Write user-specific data to user file.
BLOCK(1 .. 4) := INTEGER'IMAGE(QUITTING_SN);
BLOCK(6) := FORE_COLOR_DIGIT;
BLOCK(8) := BACK_COLOR_DIGIT;
BLOCK(10) := CHARACTER'VAL(COLOR'POS(BORDER_COLOR) + 48);
WRITE(USER_FILE, ITEM => BLOCK, TO => 1);
CLOSE(DATA_FILE);
CLOSE(USER_FILE);
end if;
end ADA_TUTR;
separate (ADA_TUTR)
procedure OPEN_DATA_FILE is
DATA_FILE_NAME : constant STRING := "ADA_TUTR.DAT";
begin
OPEN(DATA_FILE, MODE => IN_FILE, NAME => DATA_FILE_NAME);
for I in 1 .. 31 loop -- Read index from start of Data File.
READ(DATA_FILE, ITEM => BLOCK, FROM => COUNT(I));
INDX(64*I - 63 .. 64*I) := BLOCK;
end loop;
WELCOME_SN := INTEGER'VALUE(INDX(2 .. 4));
HIGHEST_SN := INTEGER'VALUE(INDX(6 .. 8));
FILES_OK := TRUE;
exception
when NAME_ERROR =>
PUT("I'm sorry. The file " & DATA_FILE_NAME);
PUT_LINE(" seems to be missing.");
when others =>
PUT("I'm sorry. The file " & DATA_FILE_NAME);
PUT_LINE(" seems to have the wrong form.");
end OPEN_DATA_FILE;
separate (ADA_TUTR)
procedure OPEN_USER_FILE is
USER_FILE_NAME : constant STRING := "ADA_TUTR.USR";
begin
OPEN(USER_FILE, MODE => INOUT_FILE, NAME => USER_FILE_NAME);
READ(USER_FILE, ITEM => BLOCK, FROM => 1);
QUITTING_SN := INTEGER'VALUE(BLOCK(1 .. 4));
OLD_SN := QUITTING_SN;
FOREGRND_COLOR := COLOR'VAL(INTEGER'VALUE(BLOCK(5 .. 6)));
BACKGRND_COLOR := COLOR'VAL(INTEGER'VALUE(BLOCK(7 .. 8)));
BORDER_COLOR := COLOR'VAL(INTEGER'VALUE(BLOCK(9 .. 10)));
FORE_COLOR_DIGIT := BLOCK(6);
BACK_COLOR_DIGIT := BLOCK(8);
NORMAL_COLORS(6) := FORE_COLOR_DIGIT;
NORMAL_COLORS(9) := BACK_COLOR_DIGIT;
exception
when NAME_ERROR =>
begin
CREATE(USER_FILE, MODE => INOUT_FILE, NAME => USER_FILE_NAME);
exception
when others =>
PUT("I'm sorry. I couldn't find or create ");
PUT_LINE(USER_FILE_NAME);
FILES_OK := FALSE;
end;
when others =>
PUT_LINE("I'm sorry. The file " & USER_FILE_NAME & " seems to have");
PUT_LINE("the wrong form or contain bad data.");
PUT_LINE("You might want to delete the file and try again.");
PUT_LINE("(Default values will be used.)");
FILES_OK := FALSE;
end OPEN_USER_FILE;
separate (ADA_TUTR)
procedure SHOW_CURRENT_SCREEN is
HALF_DIFF : INTEGER := (HIGHEST_SN - WELCOME_SN) / 2;
PERCENT : INTEGER := (50 * (OLD_SN - WELCOME_SN)) / HALF_DIFF;
-- Percentage of the course completed. Using 50 and
-- HALF_DIFF guarantees that the numerator < 2 ** 15.
EXPANDING : BOOLEAN := FALSE; -- True when expanding multiple spaces.
PROMPTING : BOOLEAN := FALSE; -- True for first character in a prompt.
SPACE : constant STRING(1 .. 80) := (others => ' ');
procedure PROCESS_CHAR is separate;
begin
VPOS := 95*(CHARACTER'POS(INDX(SN*4 - 394)) - 32) + -- Point to start
CHARACTER'POS(INDX(SN*4 - 393)) - 32; -- of current
HPOS := CHARACTER'POS(INDX(SN*4 - 392)) - 32; -- screen.
READ(DATA_FILE, ITEM => BLOCK, FROM => COUNT(VPOS));
if PERCENT < 0 then -- Make sure PERCENT is reasonable.
PERCENT := 0;
elsif PERCENT > 99 then
PERCENT := 99;
end if;
while BLOCK(HPOS) /= '[' or EXPANDING loop -- [ starts the control info.
if EXPANDING then
PUT(SPACE(1 .. CHARACTER'POS(BLOCK(HPOS)) - 32));
EXPANDING := FALSE;
elsif PROMPTING then
case BLOCK(HPOS) is
when 'b' => PUT("Please type a space to go on, or B to go back.");
when 'q' => PUT("Please type a space to go on, or B or Q to go ");
PUT("back to the question.");
when others => PROCESS_CHAR;
end case;
PROMPTING := FALSE;
else
PROCESS_CHAR;
end if;
HPOS := HPOS + 1;
if HPOS > BLOCK'LENGTH then
VPOS := VPOS + 1;
HPOS := 1;
READ(DATA_FILE, ITEM => BLOCK, FROM => COUNT(VPOS));
end if;
end loop;
end SHOW_CURRENT_SCREEN;
separate (ADA_TUTR.SHOW_CURRENT_SCREEN)
procedure PROCESS_CHAR is
begin
case BLOCK(HPOS) is
when '{' => NEW_LINE; -- { = CR-LF.
when '@' => EXPANDING := TRUE; -- @ = several spaces.
when '^' => PUT(ASCII.ESC & "[1m "); -- ^ = bright + space.
when '~' => PUT(NORMAL_COLORS & ' '); -- ~ = normal + space.
when '%' => PUT(ASCII.ESC & "[1m"); -- % = bright.
when '`' => PUT(NORMAL_COLORS); -- ` = normal.
when '}' => PUT(ASCII.ESC & "[24;1H"); -- } = go to line 24.
PROMPTING := TRUE;
when '\' => PUT(ASCII.ESC & "[7m "); -- \ = rev. vid. + sp.
when '$' => if SN = 103 then -- $ = screen #.
PUT(INTEGER'IMAGE(OLD_SN));
else
PUT('$');
end if;
when '#' => if SN = 103 then -- # = % completed.
PUT(INTEGER'IMAGE(PERCENT));
else
PUT('#');
end if;
when others => PUT(BLOCK(HPOS));
end case;
end PROCESS_CHAR;
separate (ADA_TUTR)
procedure GET_NEXT_SCREEN_NUMBER is
CTRL_INFO : BLOCK_SUBTYPE; -- Control info. for the current screen.
PLACE : INTEGER := 1; -- Current position within CTRL_INFO.
INPUT : STRING(1 .. 4); -- Screen number that you type.
LEN : INTEGER; -- Length of typed response.
VALID : BOOLEAN; -- True when typed response is valid.
procedure SET_COLORS is separate;
procedure INPUT_ONE_KEYSTROKE is separate;
begin
while BLOCK(HPOS) /= ']' loop -- Read control information from Data File.
HPOS := HPOS + 1;
if HPOS > BLOCK'LENGTH then
VPOS := VPOS + 1;
HPOS := 1;
READ(DATA_FILE, ITEM => BLOCK, FROM => COUNT(VPOS));
end if;
CTRL_INFO(PLACE) := BLOCK(HPOS);
PLACE := PLACE + 1;
end loop;
if SN = 103 then -- Screen 103 means you typed X to exit.
QUITTING_SN := OLD_SN;
elsif SN >= WELCOME_SN then -- Save SN so you can return to it.
OLD_SN := SN;
end if;
if SN < 103 then -- Set SN to # of the next screen.
SN := 0; -- Set signal to end the program after screens 101 and 102.
elsif CTRL_INFO(1) = '#' then -- You type the next screen number.
VALID := FALSE;
while not VALID loop -- Keep trying until response is valid.
PUT("# "); -- Prompt for screen number.
INPUT := " "; GET_LINE(INPUT, LEN); -- Input screen number.
if INPUT(1) = 'x' or INPUT(1) = 'X' or INPUT(1) = ASCII.ETX then
SN := 103; -- Show screen 103 if you type X.
VALID := TRUE; -- X is a valid response.
elsif INPUT(1) = 's' or INPUT(1) = 'S' then
SET_COLORS; -- Set colors if you type S.
VALID := TRUE; -- S is a valid response.
else
begin -- Convert ASCII input to
SN := INTEGER'VALUE(INPUT); -- integer. If in range,
VALID := SN in 104 .. HIGHEST_SN; -- set VALID to TRUE. If
exception -- it can't be converted
when others => null; -- (e.g., illegal char.),
end; -- or it's out of range,
end if; -- leave VALID = FALSE so
if not VALID and LEN > 0 then -- you can try again.
PUT_LINE("Incorrect number. Please try again.");
end if;
end loop;
else
INPUT_ONE_KEYSTROKE;
end if;
end GET_NEXT_SCREEN_NUMBER;
separate (ADA_TUTR.GET_NEXT_SCREEN_NUMBER)
procedure SET_COLORS is
BRIGHT : constant STRING := ASCII.ESC & "[1m"; -- Causes high intensity.
KEYSTROKE : CHARACTER := 'f'; -- Single character that you type.
SPACE : constant STRING(1 .. 23) := (others => ' ');
begin
while KEYSTROKE = 'f' or KEYSTROKE = 'b' or KEYSTROKE = 'r' or
KEYSTROKE = 'F' or KEYSTROKE = 'B' or KEYSTROKE = 'R' loop
PUT(CLEAR_SCRN); -- Clear the screen.
NEW_LINE;
PUT(SPACE & "The " & BRIGHT & "foreground" & NORMAL_COLORS);
PUT_LINE(" color is now " & COLOR'IMAGE(FOREGRND_COLOR) & '.');
PUT(SPACE & "The " & BRIGHT & "background" & NORMAL_COLORS);
PUT_LINE(" color is now " & COLOR'IMAGE(BACKGRND_COLOR) & '.');
PUT(SPACE & "The " & BRIGHT & " border " & NORMAL_COLORS);
PUT_LINE(" color is now " & COLOR'IMAGE(BORDER_COLOR) & '.');
NEW_LINE;
PUT_LINE(SPACE & " Note: Some color PCs don't have");
PUT_LINE(SPACE & " separate border colors.");
NEW_LINE;
PUT_LINE(SPACE & " Strike:");
PUT_LINE(SPACE & "F to change the foreground color,");
PUT_LINE(SPACE & "B to change the background color,");
PUT_LINE(SPACE & "R to change the border color.");
NEW_LINE;
PUT_LINE(SPACE & "Strike any other key to continue.");
GET(KEYSTROKE); -- Get one character from keyboard.
if KEYSTROKE = 'f' or KEYSTROKE = 'F' then
FOREGRND_COLOR := COLOR'VAL((COLOR'POS(FOREGRND_COLOR) + 1) mod 8);
if FOREGRND_COLOR = BACKGRND_COLOR then
FOREGRND_COLOR := COLOR'VAL((COLOR'POS(FOREGRND_COLOR) + 1) mod 8);
end if;
elsif KEYSTROKE = 'b' or KEYSTROKE = 'B' then
BACKGRND_COLOR := COLOR'VAL((COLOR'POS(BACKGRND_COLOR) + 1) mod 8);
if FOREGRND_COLOR = BACKGRND_COLOR then
BACKGRND_COLOR := COLOR'VAL((COLOR'POS(BACKGRND_COLOR) + 1) mod 8);
end if;
elsif KEYSTROKE = 'r' or KEYSTROKE = 'R' then
BORDER_COLOR := COLOR'VAL((COLOR'POS(BORDER_COLOR) + 1) mod 8);
end if;
FORE_COLOR_DIGIT := CHARACTER'VAL(48 + COLOR'POS(FOREGRND_COLOR));
BACK_COLOR_DIGIT := CHARACTER'VAL(48 + COLOR'POS(BACKGRND_COLOR));
NORMAL_COLORS(6) := FORE_COLOR_DIGIT;
NORMAL_COLORS(9) := BACK_COLOR_DIGIT;
PUT(NORMAL_COLORS);
SET_BORDER_COLOR(TO => BORDER_COLOR);
end loop;
end SET_COLORS;
separate (ADA_TUTR.GET_NEXT_SCREEN_NUMBER)
procedure INPUT_ONE_KEYSTROKE is
KEYSTROKE : CHARACTER; -- Single character that you type.
VALID : BOOLEAN := FALSE; -- True when typed response is valid.
WHERE : INTEGER; -- Location of control block in Data File.
SEARCH : CHARACTER; -- 'A' = last Outside Assignment; 'Q' = last Ques.
begin
PUT(" >"); -- Prompt for one character.
while not VALID loop -- Keep trying until response is valid.
GET(KEYSTROKE); -- Get one character from keyboard.
if KEYSTROKE in 'a' .. 'z' then -- Force upper case to simplify.
KEYSTROKE := CHARACTER'VAL(CHARACTER'POS(KEYSTROKE) - 32);
end if;
if KEYSTROKE = 'X' or KEYSTROKE = ASCII.ETX then
SN := 103; -- Show screen 103 if you type X.
VALID := TRUE; -- X is a valid response.
elsif KEYSTROKE = 'S' then
SET_COLORS; -- Set colors if you type S.
VALID := TRUE; -- S is a valid response.
end if;
PLACE := 1; -- Search list of valid characters for this screen.
VALID := VALID; -- This statement works around a minor bug in
-- ver. 1.0 of the Meridian IFORM optimizer.
while not VALID and CTRL_INFO(PLACE) /= ']' loop -- ] ends the list.
if KEYSTROKE = CTRL_INFO(PLACE) then
-- Typed char. found in list; get screen # from control info.
SN := INTEGER'VALUE(CTRL_INFO(PLACE + 1 .. PLACE + 3));
VALID := TRUE; -- Characters in the list are all valid responses.
end if;
PLACE := PLACE + 4; -- A 3-digit number follows each char. in list.
end loop;
if not VALID and KEYSTROKE /= ASCII.CR then -- Beep if response is
PUT(ASCII.BEL); -- not valid, but
end if; -- ignore CRs quietly.
end loop;
if SN = 98 then -- Go back to last Outside Assignment.
SEARCH := 'A';
elsif SN = 99 then -- Go back to last question.
SEARCH := 'Q';
elsif SN = 100 then -- Go back to the last screen seen.
SN := QUITTING_SN;
end if;
if SN = 98 or SN = 99 then
SN := OLD_SN;
while SN > WELCOME_SN and INDX(SN*4 - 395) /= SEARCH loop
SN := SN - 1;
end loop;
end if;
end INPUT_ONE_KEYSTROKE;